home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / kcl.lha / cmpnew / cmpwt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  10.0 KB  |  498 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "cmpwt.h"
  5. init_cmpwt(start,size,data)char *start;int size;object data;
  6. {    register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
  7.     Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
  8.     MF(VV[37],L1,start,size,data);
  9.     MF(VV[25],L2,start,size,data);
  10.     MF(VV[29],L3,start,size,data);
  11.     MF(VV[38],L4,start,size,data);
  12.     MF(VV[39],L5,start,size,data);
  13.     MF(VV[40],L6,start,size,data);
  14.     MF(VV[41],L7,start,size,data);
  15.     MM(VV[6],L8,start,size,data);
  16.     MM(VV[42],L9,start,size,data);
  17.     MM(VV[43],L10,start,size,data);
  18.     MM(VV[44],L11,start,size,data);
  19.     vs_top=vs_base=base;
  20. }
  21. /*    function definition for WT-COMMENT    */
  22.  
  23. static L1()
  24. {    register object *base=vs_base;
  25.     register object *sup=base+VM3;
  26.     vs_reserve(VM3);
  27.     if(vs_top-vs_base<1) too_few_arguments();
  28.     if(vs_top-vs_base>2) too_many_arguments();
  29.     vs_base=vs_base+1;
  30.     if(vs_base>=vs_top){vs_top=sup;goto T1;}
  31.     vs_top=sup;
  32.     goto T2;
  33. T1:;
  34.     base[1]= Cnil;
  35. T2:;
  36.     princ_str("\n/*    ",VV[0]);
  37.     (void)(princ(base[0],symbol_value(VV[0])));
  38.     if((base[1])==Cnil){
  39.     goto T6;}
  40.     base[3]= base[1];
  41.     vs_top=(vs_base=base+3)+1;
  42.     Lsymbol_name();
  43.     vs_top=sup;
  44.     base[2]= vs_base[0];
  45.     {int V1;
  46.     int V2;
  47.     V1= length(base[2]);
  48.     V2= 0;
  49. T14:;
  50.     if(!((V2)>=(V1))){
  51.     goto T15;}
  52.     goto T6;
  53. T15:;
  54.     {unsigned char V3;
  55.     V3= char_code(elt(base[2],V2));
  56.     if((V3)==(47)){
  57.     goto T19;}
  58.     (void)(princ(code_char(V3),symbol_value(VV[0])));}
  59. T19:;
  60.     V2= (V2)+1;
  61.     goto T14;}
  62. T6:;
  63.     princ_str("    */\n",VV[0]);
  64.     base[2]= Cnil;
  65.     vs_top=(vs_base=base+2)+1;
  66.     return;
  67. }
  68. /*    function definition for WT1    */
  69.  
  70. static L2()
  71. {    register object *base=vs_base;
  72.     register object *sup=base+VM4;
  73.     vs_reserve(VM4);
  74.     check_arg(1);
  75.     vs_top=sup;
  76. TTL:;
  77.     if(type_of(base[0])==t_string){
  78.     goto T28;}
  79.     if(type_of(base[0])==t_fixnum||type_of(base[0])==t_bignum){
  80.     goto T28;}
  81.     if(!(type_of(base[0])==t_character)){
  82.     goto T29;}
  83. T28:;
  84.     (void)(princ(base[0],symbol_value(VV[0])));
  85.     goto T27;
  86. T29:;
  87.     base[1]= base[0];
  88.     base[2]= VV[3];
  89.     if((simple_symlispcall_no_event(VV[45],base+1,2))!=Cnil){
  90.     goto T35;}
  91.     base[1]= base[0];
  92.     base[2]= VV[4];
  93.     if((simple_symlispcall_no_event(VV[45],base+1,2))==Cnil){
  94.     goto T36;}
  95. T35:;
  96.     base[1]= symbol_value(VV[0]);
  97.     base[2]= VV[5];
  98.     base[3]= base[0];
  99.     vs_top=(vs_base=base+1)+3;
  100.     Lformat();
  101.     vs_top=sup;
  102.     goto T27;
  103. T36:;
  104.     base[1]= base[0];
  105.     (void)simple_symlispcall_no_event(VV[46],base+1,1);
  106. T27:;
  107.     base[1]= Cnil;
  108.     vs_top=(vs_base=base+1)+1;
  109.     return;
  110. }
  111. /*    function definition for WT-H1    */
  112.  
  113. static L3()
  114. {    register object *base=vs_base;
  115.     register object *sup=base+VM5;
  116.     vs_reserve(VM5);
  117.     check_arg(1);
  118.     vs_top=sup;
  119. TTL:;
  120.     if(!(type_of(base[0])==t_cons)){
  121.     goto T50;}
  122.     base[1]= get(car(base[0]),VV[6],Cnil);
  123.     if((base[1])==Cnil){
  124.     goto T54;}
  125.     base[2]= base[1];
  126.     {object V4;
  127.     V4= cdr(base[0]);
  128.      vs_top=base+3;
  129.      while(!endp(V4))
  130.      {vs_push(car(V4));V4=cdr(V4);}
  131.     vs_base=base+3;}
  132.     super_funcall_no_event(base[2]);
  133.     vs_top=sup;
  134.     goto T48;
  135. T54:;
  136.     base[2]= VV[7];
  137.     base[3]= base[0];
  138.     (void)simple_symlispcall_no_event(VV[47],base+2,2);
  139.     goto T48;
  140. T50:;
  141.     (void)(princ(base[0],symbol_value(VV[8])));
  142. T48:;
  143.     base[1]= Cnil;
  144.     vs_top=(vs_base=base+1)+1;
  145.     return;
  146. }
  147. /*    function definition for WT-DATA    */
  148.  
  149. static L4()
  150. {    register object *base=vs_base;
  151.     register object *sup=base+VM6;
  152.     vs_reserve(VM6);
  153.     bds_check;
  154.     check_arg(1);
  155.     vs_top=sup;
  156. TTL:;
  157.     bds_bind(VV[9],Cnil);
  158.     bds_bind(VV[10],VV[11]);
  159.     bds_bind(VV[12],Ct);
  160.     bds_bind(VV[13],Cnil);
  161.     bds_bind(VV[14],Cnil);
  162.     bds_bind(VV[15],Cnil);
  163.     bds_bind(VV[16],VV[17]);
  164.     bds_bind(VV[18],Ct);
  165.     bds_bind(VV[19],Ct);
  166.     bds_bind(VV[20],Ct);
  167.     bds_bind(VV[21],Ct);
  168.     princ_char(10,VV[22]);
  169.     (void)(prin1(base[0],symbol_value(VV[22])));
  170.     base[12]= Cnil;
  171.     vs_top=(vs_base=base+12)+1;
  172.     bds_unwind1;
  173.     bds_unwind1;
  174.     bds_unwind1;
  175.     bds_unwind1;
  176.     bds_unwind1;
  177.     bds_unwind1;
  178.     bds_unwind1;
  179.     bds_unwind1;
  180.     bds_unwind1;
  181.     bds_unwind1;
  182.     bds_unwind1;
  183.     return;
  184. }
  185. /*    function definition for WT-DATA-BEGIN    */
  186.  
  187. static L5()
  188. {    register object *base=vs_base;
  189.     register object *sup=base+VM7;
  190.     vs_reserve(VM7);
  191.     check_arg(0);
  192.     vs_top=sup;
  193. TTL:;
  194.     princ_str("          ",VV[22]);
  195.     princ_char(10,VV[22]);
  196.     princ_str("#(",VV[22]);
  197.     base[0]= Cnil;
  198.     vs_top=(vs_base=base+0)+1;
  199.     return;
  200. }
  201. /*    function definition for WT-DATA-END    */
  202.  
  203. static L6()
  204. {    register object *base=vs_base;
  205.     register object *sup=base+VM8;
  206.     vs_reserve(VM8);
  207.     check_arg(0);
  208.     vs_top=sup;
  209. TTL:;
  210.     princ_char(10,VV[22]);
  211.     princ_char(41,VV[22]);
  212.     princ_char(10,VV[22]);
  213.     base[0]= Cnil;
  214.     vs_top=(vs_base=base+0)+1;
  215.     return;
  216. }
  217. /*    function definition for WT-DATA-PACKAGE-OPERATION    */
  218.  
  219. static L7()
  220. {    register object *base=vs_base;
  221.     register object *sup=base+VM9;
  222.     vs_reserve(VM9);
  223.     check_arg(1);
  224.     vs_top=sup;
  225. TTL:;
  226.     princ_char(10,VV[22]);
  227.     princ_str("#!",VV[22]);
  228.     base[1]= base[0];
  229.     vs_top=(vs_base=base+1)+1;
  230.     L4();
  231.     return;
  232. }
  233. /*    macro definition for WT    */
  234.  
  235. static L8()
  236. {    register object *base=vs_base;
  237.     register object *sup=base+VM10;
  238.     vs_reserve(VM10);
  239.     check_arg(2);
  240.     vs_top=sup;
  241.     {object V5=base[0]->c.c_cdr;
  242.     base[2]= V5;
  243.     base[3]= Cnil;}
  244.     {object V6;
  245.     object V7;
  246.     V6= base[2];
  247.     V7= car((V6));
  248. T75:;
  249.     if(!(endp((V6)))){
  250.     goto T76;}
  251.     base[4]= make_cons(Cnil,base[3]);
  252.     base[5]= reverse(base[4]);
  253.     base[6]= make_cons(VV[23],base[5]);
  254.     vs_top=(vs_base=base+6)+1;
  255.     return;
  256. T76:;
  257.     if(!(type_of((V7))==t_string)){
  258.     goto T82;}
  259.     base[4]= list(3,VV[24],(V7),VV[0]);
  260.     base[3]= make_cons(base[4],base[3]);
  261.     goto T80;
  262. T82:;
  263.     base[4]= list(2,VV[25],(V7));
  264.     base[3]= make_cons(base[4],base[3]);
  265. T80:;
  266.     V6= cdr((V6));
  267.     V7= car((V6));
  268.     goto T75;}
  269. }
  270. /*    macro definition for WT-H    */
  271.  
  272. static L9()
  273. {    register object *base=vs_base;
  274.     register object *sup=base+VM11;
  275.     vs_reserve(VM11);
  276.     check_arg(2);
  277.     vs_top=sup;
  278.     {object V8=base[0]->c.c_cdr;
  279.     base[2]= V8;
  280.     base[3]= Cnil;}
  281.     if(!(endp(base[2]))){
  282.     goto T93;}
  283.     base[4]= VV[26];
  284.     vs_top=(vs_base=base+4)+1;
  285.     return;
  286. T93:;
  287.     if(!(type_of(car(base[2]))==t_string)){
  288.     goto T96;}
  289.     {object V9;
  290.     object V10;
  291.     V9= cdr(base[2]);
  292.     V10= car((V9));
  293. T101:;
  294.     if(!(endp((V9)))){
  295.     goto T102;}
  296.     base[5]= VV[27];
  297.     base[6]= VV[28];
  298.     base[7]= car(base[2]);
  299.     base[4]= simple_symlispcall_no_event(VV[48],base+5,3);
  300.     base[5]= list(3,VV[24],base[4],VV[8]);
  301.     base[6]= make_cons(Cnil,base[3]);
  302.     base[7]= reverse(base[6]);
  303.     base[8]= listA(3,VV[23],base[5],base[7]);
  304.     vs_top=(vs_base=base+8)+1;
  305.     return;
  306. T102:;
  307.     if(!(type_of((V10))==t_string)){
  308.     goto T112;}
  309.     base[4]= list(3,VV[24],(V10),VV[8]);
  310.     base[3]= make_cons(base[4],base[3]);
  311.     goto T110;
  312. T112:;
  313.     base[4]= list(2,VV[29],(V10));
  314.     base[3]= make_cons(base[4],base[3]);
  315. T110:;
  316.     V9= cdr((V9));
  317.     V10= car((V9));
  318.     goto T101;}
  319. T96:;
  320.     {object V11;
  321.     object V12;
  322.     V11= base[2];
  323.     V12= car((V11));
  324. T124:;
  325.     if(!(endp((V11)))){
  326.     goto T125;}
  327.     base[4]= make_cons(Cnil,base[3]);
  328.     base[5]= reverse(base[4]);
  329.     base[6]= listA(3,VV[23],VV[30],base[5]);
  330.     vs_top=(vs_base=base+6)+1;
  331.     return;
  332. T125:;
  333.     if(!(type_of((V12))==t_string)){
  334.     goto T131;}
  335.     base[4]= list(3,VV[24],(V12),VV[8]);
  336.     base[3]= make_cons(base[4],base[3]);
  337.     goto T129;
  338. T131:;
  339.     base[4]= list(2,VV[29],(V12));
  340.     base[3]= make_cons(base[4],base[3]);
  341. T129:;
  342.     V11= cdr((V11));
  343.     V12= car((V11));
  344.     goto T124;}
  345. }
  346. /*    macro definition for WT-NL    */
  347.  
  348. static L10()
  349. {    register object *base=vs_base;
  350.     register object *sup=base+VM12;
  351.     vs_reserve(VM12);
  352.     check_arg(2);
  353.     vs_top=sup;
  354.     {object V13=base[0]->c.c_cdr;
  355.     base[2]= V13;
  356.     base[3]= Cnil;}
  357.     if(!(endp(base[2]))){
  358.     goto T142;}
  359.     base[4]= VV[31];
  360.     vs_top=(vs_base=base+4)+1;
  361.     return;
  362. T142:;
  363.     if(!(type_of(car(base[2]))==t_string)){
  364.     goto T145;}
  365.     {object V14;
  366.     object V15;
  367.     V14= cdr(base[2]);
  368.     V15= car((V14));
  369. T150:;
  370.     if(!(endp((V14)))){
  371.     goto T151;}
  372.     base[5]= VV[27];
  373.     base[6]= VV[32];
  374.     base[7]= car(base[2]);
  375.     base[4]= simple_symlispcall_no_event(VV[48],base+5,3);
  376.     base[5]= list(3,VV[24],base[4],VV[0]);
  377.     base[6]= make_cons(Cnil,base[3]);
  378.     base[7]= reverse(base[6]);
  379.     base[8]= listA(3,VV[23],base[5],base[7]);
  380.     vs_top=(vs_base=base+8)+1;
  381.     return;
  382. T151:;
  383.     if(!(type_of((V15))==t_string)){
  384.     goto T161;}
  385.     base[4]= list(3,VV[24],(V15),VV[0]);
  386.     base[3]= make_cons(base[4],base[3]);
  387.     goto T159;
  388. T161:;
  389.     base[4]= list(2,VV[25],(V15));
  390.     base[3]= make_cons(base[4],base[3]);
  391. T159:;
  392.     V14= cdr((V14));
  393.     V15= car((V14));
  394.     goto T150;}
  395. T145:;
  396.     {object V16;
  397.     object V17;
  398.     V16= base[2];
  399.     V17= car((V16));
  400. T173:;
  401.     if(!(endp((V16)))){
  402.     goto T174;}
  403.     base[4]= make_cons(Cnil,base[3]);
  404.     base[5]= reverse(base[4]);
  405.     base[6]= listA(3,VV[23],VV[33],base[5]);
  406.     vs_top=(vs_base=base+6)+1;
  407.     return;
  408. T174:;
  409.     if(!(type_of((V17))==t_string)){
  410.     goto T180;}
  411.     base[4]= list(3,VV[24],(V17),VV[0]);
  412.     base[3]= make_cons(base[4],base[3]);
  413.     goto T178;
  414. T180:;
  415.     base[4]= list(2,VV[25],(V17));
  416.     base[3]= make_cons(base[4],base[3]);
  417. T178:;
  418.     V16= cdr((V16));
  419.     V17= car((V16));
  420.     goto T173;}
  421. }
  422. /*    macro definition for WT-NL1    */
  423.  
  424. static L11()
  425. {    register object *base=vs_base;
  426.     register object *sup=base+VM13;
  427.     vs_reserve(VM13);
  428.     check_arg(2);
  429.     vs_top=sup;
  430.     {object V18=base[0]->c.c_cdr;
  431.     base[2]= V18;
  432.     base[3]= Cnil;}
  433.     if(!(endp(base[2]))){
  434.     goto T191;}
  435.     base[4]= VV[34];
  436.     vs_top=(vs_base=base+4)+1;
  437.     return;
  438. T191:;
  439.     if(!(type_of(car(base[2]))==t_string)){
  440.     goto T194;}
  441.     {object V19;
  442.     object V20;
  443.     V19= cdr(base[2]);
  444.     V20= car((V19));
  445. T199:;
  446.     if(!(endp((V19)))){
  447.     goto T200;}
  448.     base[5]= VV[27];
  449.     base[6]= VV[35];
  450.     base[7]= car(base[2]);
  451.     base[4]= simple_symlispcall_no_event(VV[48],base+5,3);
  452.     base[5]= list(3,VV[24],base[4],VV[0]);
  453.     base[6]= make_cons(Cnil,base[3]);
  454.     base[7]= reverse(base[6]);
  455.     base[8]= listA(3,VV[23],base[5],base[7]);
  456.     vs_top=(vs_base=base+8)+1;
  457.     return;
  458. T200:;
  459.     if(!(type_of((V20))==t_string)){
  460.     goto T210;}
  461.     base[4]= list(3,VV[24],(V20),VV[0]);
  462.     base[3]= make_cons(base[4],base[3]);
  463.     goto T208;
  464. T210:;
  465.     base[4]= list(2,VV[25],(V20));
  466.     base[3]= make_cons(base[4],base[3]);
  467. T208:;
  468.     V19= cdr((V19));
  469.     V20= car((V19));
  470.     goto T199;}
  471. T194:;
  472.     {object V21;
  473.     object V22;
  474.     V21= base[2];
  475.     V22= car((V21));
  476. T222:;
  477.     if(!(endp((V21)))){
  478.     goto T223;}
  479.     base[4]= make_cons(Cnil,base[3]);
  480.     base[5]= reverse(base[4]);
  481.     base[6]= listA(3,VV[23],VV[36],base[5]);
  482.     vs_top=(vs_base=base+6)+1;
  483.     return;
  484. T223:;
  485.     if(!(type_of((V22))==t_string)){
  486.     goto T229;}
  487.     base[4]= list(3,VV[24],(V22),VV[0]);
  488.     base[3]= make_cons(base[4],base[3]);
  489.     goto T227;
  490. T229:;
  491.     base[4]= list(2,VV[25],(V22));
  492.     base[3]= make_cons(base[4],base[3]);
  493. T227:;
  494.     V21= cdr((V21));
  495.     V22= car((V21));
  496.     goto T222;}
  497. }
  498.